{- «•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»

    Copyright © 2011 - 2021, Ingo Wechsung
    All rights reserved.
    
    Redistribution and use in source and binary forms, with or
    without modification, are permitted provided that the following
    conditions are met:
    
        Redistributions of source code must retain the above copyright
        notice, this list of conditions and the following disclaimer.
    
        Redistributions in binary form must reproduce the above
        copyright notice, this list of conditions and the following
        disclaimer in the documentation and/or other materials provided
        with the distribution. Neither the name of the copyright holder
        nor the names of its contributors may be used to endorse or
        promote products derived from this software without specific
        prior written permission. 
        
    THIS SOFTWARE IS PROVIDED BY THE
    COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER
    OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
    USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
    AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
    IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    THE POSSIBILITY OF SUCH DAMAGE.

    «•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•» -}

{--
 * Here live all classes and interfaces from @java.lang@ except those already
 * introduced in the Prelude.
 -}


protected package frege.java.Lang 
        inline (Byte.unsigned)
    where

import frege.prelude.PreludeArrays (ArrayElement, JArray, PrimitiveArrayElement, ArrayOf)
import frege.prelude.PreludeBase
import frege.prelude.PreludeBase public(Throwable, Object,
    ClassNotFoundException,
    NumberFormatException,
    InterruptedException)
import frege.prelude.PreludeIO (Exceptional, Mutable, MutableIO, Serializable, STMutable, readonly)
import frege.prelude.PreludeIO public(Exception)
-- import frege.prelude.PreludeText
import frege.prelude.PreludeMonad
import frege.prelude.PreludeList (ListSource, length, map, fold, zipWith, null, zip) 


-- -------------------------------------------------------------------------
-- ---------------------- several exceptions -------------------------------
-- -------------------------------------------------------------------------
instance Exceptional Throwable where
    pure native javaClass "java.lang.Throwable.class" :: Class Throwable

instance Exceptional ClassNotFoundException where
    pure native javaClass "java.lang.ClassNotFoundException.class" :: Class ClassNotFoundException

protected data IOException = pure native java.io.IOException
derive Exceptional IOException

derive Exceptional InterruptedException

data IllegalStateException = pure native java.lang.IllegalStateException
derive Exceptional IllegalStateException

data IllegalThreadStateException = pure native java.lang.IllegalThreadStateException
derive Exceptional IllegalThreadStateException

data InstantiationException = pure native java.lang.InstantiationException
derive Exceptional InstantiationException

data NoSuchFieldException = pure native java.lang.NoSuchFieldException
derive Exceptional NoSuchFieldException

data IllegalAccessException = pure native java.lang.IllegalAccessException
derive Exceptional IllegalAccessException

data IllegalArgumentException = pure native java.lang.IllegalArgumentException where
    --- temporary 'new' name until name lookup bug fixed
    pure native new :: String -> IllegalArgumentException
                     | String -> Throwable -> IllegalArgumentException
derive Exceptional IllegalArgumentException

data SecurityException = pure native java.lang.SecurityException
derive Exceptional SecurityException

data NullPointerException = pure native java.lang.NullPointerException
derive Exceptional NullPointerException

data Error = pure native java.lang.Error
derive Exceptional Error

data NoSuchMethodError = pure native java.lang.NoSuchMethodError
derive Exceptional NoSuchMethodError

data ExceptionInInitializerError = pure native java.lang.ExceptionInInitializerError
derive Exceptional ExceptionInInitializerError

data IndexOutOfBoundsException = pure native java.lang.IndexOutOfBoundsException
derive Exceptional IndexOutOfBoundsException

data StringIndexOutOfBoundsException = pure native java.lang.StringIndexOutOfBoundsException
derive Exceptional StringIndexOutOfBoundsException

-- -------------------------------------------------------------------------
-- ---------------------- Runnable  ----------------------------------------
-- -------------------------------------------------------------------------
native module where {
    public static<S> java.lang.Runnable runnable(final Func.U<S,Short> arg1) {
        return new java.lang.Runnable() {
            public void run() {
                final short done = PreludeBase.TST.run(
                    RunTM.<Func.U<Object,Short>>cast(arg1)).call();
            }
        };
    }
}

--- A @java.lang.Runnable@, can be created from 'IO' or 'ST' actions
data Runnable = native java.lang.Runnable where
    --- nowarn: argument of type 'ST' s ()
    --- Create a java Runnable from a 'ST' @s@ '()'.
    --- When the @run@ method is called from java code, the ST action will be performed.
    native new Lang.runnable :: ST s () -> ST s (Mutable s Runnable)
    --- perform the ST action that is associated with this runnable.
    native run :: Mutable s Runnable -> ST s ()

-- -------------------------------------------------------------------------
-- ---------------------- Class Loading & Resources ------------------------
-- -------------------------------------------------------------------------

protected data MetaFP = pure native "frege.runtime.Meta.FregePackage"

private pure native md "frege.runtime.Meta.FregePackage.class" :: Class MetaFP

data ClassLoader =  native java.lang.ClassLoader where
        native getClassLoader :: Class a -> ST s (Mutable s ClassLoader)
        current = getClassLoader md

protected data PrintStream = native java.io.PrintStream

data Appendable = native java.lang.Appendable where
    native append :: Mutable s Appendable -> Char -> ST s (Mutable s Appendable)
                        throws IOException
                  |  Mutable s Appendable -> String -> ST s (Mutable s Appendable)
                        throws IOException


data System = pure native java.lang.System where
    pure native getenv          java.lang.System.getenv         :: String -> Maybe String
    pure native getProperty     java.lang.System.getProperty    :: String -> Maybe String
    pure native lineSeparator   java.lang.System.lineSeparator  :: () -> String
    native exit                 java.lang.System.exit           :: Int -> IO ()
    native currentTimeMillis    java.lang.System.currentTimeMillis
                                                                :: () -> IO Long
    native nanoTime             java.lang.System.nanoTime       :: () -> IO Long
    --- nowarn: System.err is not supposed to change
    native err "java.lang.System.err" :: MutableIO PrintStream
    --- nowarn: System.out is not supposed to change
    native out "java.lang.System.out" :: MutableIO PrintStream
    --- expose memory / cpu related functions here for convenience
    native availableProcessors "java.lang.Runtime.getRuntime().availableProcessors"
                                                                :: () -> IO Int
    native freeMemory "java.lang.Runtime.getRuntime().freeMemory"
                                                                :: () -> IO Long
    native maxMemory "java.lang.Runtime.getRuntime().maxMemory" :: () -> IO Long
    native totalMemory "java.lang.Runtime.getRuntime().totalMemory"
                                                                :: () -> IO Long


data CharSequence = pure native java.lang.CharSequence where
    pure native charAt                                  :: CharSequence -> Int -> Char
    pure native length                                  :: CharSequence -> Int
    pure native subSeq  subSequence                     :: CharSequence -> Int -> Int -> CharSequence
    pure native toString                                :: CharSequence -> String
    pure native fromString "(java.lang.CharSequence)"   :: String -> CharSequence
    {--
        Returns the code point at the given index of the 'CharSequence'.
        If the char value at the given index in the CharSequence is
        in the high-surrogate range,
        the following index is less than the length of the CharSequence,
        and the char value at the following index is in the low-surrogate range,
        then the supplementary code point corresponding to this surrogate pair is returned.

        Otherwise, the char value at the given index is returned.

        Note that the corresponding java method is from @java.lang.Character@,
        but logically fits in here better.

        See also: 'Char.isSupplementaryCodePoint'
    -}
    pure native codePointAt
                "java.lang.Character.codePointAt"       :: CharSequence -> Int -> Int


--- Resembles @java.lang.StringBuilder@
data StringBuilder = native java.lang.StringBuilder where
    native new      :: String -> ST s (Mutable s StringBuilder)
    native toString :: Mutable s StringBuilder -> ST s String

-- -------------------------------------------------------------------------
-- ---------------------- Threads  -----------------------------------------
-- -------------------------------------------------------------------------

--- An OS thread
data Thread = native java.lang.Thread where
    native new      :: MutableIO Runnable -> IO (MutableIO Thread)
    native start    :: MutableIO Thread -> IO ()
    native setName  :: MutableIO Thread -> String -> IO ()
    native getName  :: MutableIO Thread -> IO String

    --- Obtain the current 'Thread'
    native current  java.lang.Thread.currentThread
                    :: () -> IO (MutableIO Thread)

    --- Sleep for a number of milliseconds.
    native sleep java.lang.Thread.sleep
                    :: Long -> IO () throws InterruptedException


data Boolean = pure native java.lang.Boolean
data Character = pure native java.lang.Character

data Readable = native "java.lang.Readable"

data StringBuffer = native java.lang.StringBuffer where

  native new :: CharSequence -> STMutable s StringBuffer
              | String -> STMutable s StringBuffer
              | Int -> STMutable s StringBuffer
              | () -> STMutable s StringBuffer

  native append :: Mutable s StringBuffer -> Float -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Double -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Bool -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Char -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Long -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Object -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> CharSequence -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> CharSequence -> Int -> Int -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Mutable s (JArray Char) -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Mutable s (JArray Char) -> Int -> Int -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> String -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Mutable s StringBuffer -> STMutable s StringBuffer

  native appendCodePoint :: Mutable s StringBuffer -> Int -> STMutable s StringBuffer

  native capacity :: Mutable s StringBuffer -> ST s Int

  native charAt :: Mutable s StringBuffer -> Int -> ST s Char

  native codePointAt :: Mutable s StringBuffer -> Int -> ST s Int

  native codePointBefore :: Mutable s StringBuffer -> Int -> ST s Int

  native codePointCount :: Mutable s StringBuffer -> Int -> Int -> ST s Int

  native delete :: Mutable s StringBuffer -> Int -> Int -> STMutable s StringBuffer

  native deleteCharAt :: Mutable s StringBuffer -> Int -> STMutable s StringBuffer

  native ensureCapacity :: Mutable s StringBuffer -> Int -> ST s ()

  native getChars :: Mutable s StringBuffer -> Int -> Int -> Mutable s (JArray Char) -> Int -> ST s ()

  native indexOf :: Mutable s StringBuffer -> String -> ST s Int
                  | Mutable s StringBuffer -> String -> Int -> ST s Int

  native insert :: Mutable s StringBuffer -> Int -> Mutable s (JArray Char) -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> CharSequence -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> CharSequence -> Int -> Int -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Bool -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Char -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Double -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Mutable s (JArray Char) -> Int -> Int -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Object -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> String -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Float -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Long -> STMutable s StringBuffer
                 | Mutable s StringBuffer -> Int -> Int -> STMutable s StringBuffer

  native lastIndexOf :: Mutable s StringBuffer -> String -> ST s Int
                      | Mutable s StringBuffer -> String -> Int -> ST s Int

  native length :: Mutable s StringBuffer -> ST s Int

  native offsetByCodePoints :: Mutable s StringBuffer -> Int -> Int -> ST s Int

  native replace :: Mutable s StringBuffer -> Int -> Int -> String -> STMutable s StringBuffer

  native reverse :: Mutable s StringBuffer -> STMutable s StringBuffer

  native setCharAt :: Mutable s StringBuffer -> Int -> Char -> ST s ()

  native setLength :: Mutable s StringBuffer -> Int -> ST s ()

  native subSequence :: Mutable s StringBuffer -> Int -> Int -> ST s CharSequence

  native substring :: Mutable s StringBuffer -> Int -> ST s String
                    | Mutable s StringBuffer -> Int -> Int -> ST s String

  native toString :: Mutable s StringBuffer -> ST s String

  native trimToSize :: Mutable s StringBuffer -> ST s ()

instance Serializable StringBuffer

data Comparable t = pure native java.lang.Comparable where

  pure native compareTo :: Comparable t -> t -> Int

-- forward declaration
protected data Iterator e = native java.util.Iterator

data Iterable t = pure native java.lang.Iterable where
  native iterator :: Iterable t -> STMutable s (Iterator t)

--- 'Byte' is the Frege type for the primitive JVM @byte@
--- However, it is given _unsigend_ semantics in Frege.
--- Use 'Byte' only in 'JArray's or tightly packed records! 
--- Otherwise you'll waste time while not saving space.
data Byte = pure native "byte" where    
    --- this gives the 'Int' corresponding to the *signed* interpretation of the 'Byte'
    pure native signed "(int)"  :: Byte -> Int
    --- this gives the 'Int' corresponding to the *unsigned* interpretation of the 'Byte'
    unsigned b = signed b Int..&. 0xFF 

--- convert an 'Int' to a 'Byte' by chopping off the leading 24 bits.
pure native byte "(byte)" :: Int -> Byte

instance Eq Byte where
    hashCode  = Byte.unsigned    
    pure native == :: Byte -> Byte -> Bool
    pure native != :: Byte -> Byte -> Bool

--- The 'Ord' instance for 'Byte's assumes that bytes are unsigned.
--- Hence
--- > byte (-1) > byte 1
instance Ord Byte where
    a <=> b  = a.unsigned Int.<=> b.unsigned
    a <   b  = a.unsigned Int.<   b.unsigned
    a   > b  = a.unsigned Int.>   b.unsigned
    a <=  b  = a.unsigned Int.<=  b.unsigned
    a  >= b  = a.unsigned Int.>=  b.unsigned    

instance Num Byte where
    fromInt = byte
    one     = byte 1
    zero    = byte 0
    fromInteger n = fromInt (fromInteger n)
    --- A no-op, since 'Byte's are unsigned
    abs b   = b
    --- Never -1, since 'Byte's are unsigned
    sign b  = if b > zero then 1 else 0
    b1 + b2 = byte (b1.unsigned + b2.unsigned) 
    b1 - b2 = byte (b1.unsigned - b2.unsigned)
    b1 * b2 = byte (b1.unsigned * b2.unsigned)

instance Integral Byte where 
    odd b   = odd b.unsigned
    even b  = even b.unsigned
    big b   = big b.unsigned
    a `quot` b = byte (a.unsigned `quot` b.unsigned)
    a `rem`  b = byte (a.unsigned `rem`  b.unsigned)

instance Bounded Byte where
    minBound = zero
    maxBound = byte 255
    
instance Enum Byte where
    from = fromInt
    ord  = Byte.unsigned
    succ b
        | b < maxBound = byte (b.unsigned + 1)
        | otherwise    = error "Byte.succ 255"
    pred b
        | b > minBound = byte (b.unsigned - 1)
        | otherwise    = error "Byte.pred 0"
    
    enumFromThenTo a b l
            | a < b, a <= l = stepUp a   (b-a) l
            | a > b, a >= l = stepDown a (a-b) l
            | otherwise    = []
        where
            stepUp !a !s !l  
                | a <= l = a : if a+s > a then stepUp (a+s) s l else []
                | otherwise = []
            stepDown !a !s !l
                | a >= l = a : if a-s < a then stepDown (a-s) s l else []
                | otherwise = []
    
    enumFromThen a b
        | a < b = enumFromThenTo a b maxBound
        | a > b = enumFromThenTo a b minBound
        | otherwise = []
    
    enumFromTo a b
        | a < b     = a:enumFromTo (succ a) b
        | a == b    = [a]
        | otherwise = []
    
    enumFrom a = enumFromTo a maxBound
    

instance PrimitiveArrayElement Byte where
    native javaClass "byte.class" :: Class Byte

--- 'Short' is the Frege type for the primitive JVM @short@
--- However, it is given _unsigend_ semantics in Frege.
--- Use 'Short' only in 'JArray's or tightly packed records! 
--- Otherwise you'll waste time while not saving space.
data Short = pure native "short" where
    --- this gives the 'Int' corresponding to the *signed* interpretation of 'Short'
    pure native signed "(int)"  :: Short -> Int
    --- this gives the 'Int' corresponding to the *unsigned* interpretation of 'Short'
    unsigned b = signed b Int..&. 0xFFFF 

--- convert an 'Int' to a 'Short' by chopping off the leading 16 bits.
pure native short "(short)" :: Int -> Short

instance Eq Short where
    hashCode  = Short.unsigned    
    pure native == :: Short -> Short -> Bool
    pure native != :: Short -> Short -> Bool

--- The 'Ord' instance for 'Byte's assumes that bytes are unsigned.
--- Hence
--- > byte (-1) > byte 1
instance Ord Short where
    a <=> b  = a.unsigned Int.<=> b.unsigned
    a <   b  = a.unsigned Int.<   b.unsigned
    a   > b  = a.unsigned Int.>   b.unsigned
    a <=  b  = a.unsigned Int.<=  b.unsigned
    a  >= b  = a.unsigned Int.>=  b.unsigned    

instance Num Short where
    fromInt = short
    one     = short 1
    zero    = short 0
    fromInteger n = fromInt (fromInteger n)
    --- A no-op, since 'Short's are unsigned
    abs b   = b
    --- Never -1, since 'Short's are unsigned
    sign b  = if b > zero then 1 else 0
    b1 + b2 = short (b1.unsigned + b2.unsigned) 
    b1 - b2 = short (b1.unsigned - b2.unsigned)
    b1 * b2 = short (b1.unsigned * b2.unsigned)

instance Integral Short where 
    odd b   = odd b.unsigned
    even b  = even b.unsigned
    big b   = big b.unsigned
    a `quot` b = short (a.unsigned `quot` b.unsigned)
    a `rem`  b = short (a.unsigned `rem`  b.unsigned)

instance Bounded Short where
    minBound = zero
    maxBound = short 0xffff
    
instance Enum Short where
    from = fromInt
    ord  = Short.unsigned
    succ b
        | b < maxBound = short (b.unsigned + 1)
        | otherwise    = error "Short.succ 0xffff"
    pred b
        | b > minBound = short (b.unsigned - 1)
        | otherwise    = error "Short.pred 0"
    
    enumFromThenTo a b l
            | a < b, a <= l = stepUp a   (b-a) l
            | a > b, a >= l = stepDown a (a-b) l
            | otherwise    = []
        where
            stepUp !a !s !l  
                | a <= l = a : if a+s > a then stepUp (a+s) s l else []
                | otherwise = []
            stepDown !a !s !l
                | a >= l = a : if a-s < a then stepDown (a-s) s l else []
                | otherwise = []

    enumFromThen a b
        | a < b = enumFromThenTo a b maxBound
        | a > b = enumFromThenTo a b minBound
        | otherwise = []

    enumFromTo a b
        | a < b     = a:enumFromTo (succ a) b
        | a == b    = [a]
        | otherwise = []

    enumFrom a = enumFromTo a maxBound



instance PrimitiveArrayElement Short where
    native javaClass "short.class" :: Class Short

data JEnum (e ≤ JEnum e) = pure native "java.lang.Enum" {e}


--instance ArrayElement (JEnum x) where
--    native javaClass "java.lang.Enum.class" :: Class (JEnum x)

instance ArrayElement Object where
  native javaClass "java.lang.Object.class" :: Class Object

